home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Trees / V6 / usr / source / tmg / tmga.s < prev    next >
Encoding:
Text File  |  1975-05-13  |  7.4 KB  |  487 lines
  1. / tmg
  2. / main program and parsing rule interpreter
  3. /
  4. tracing = 1
  5. f = r5
  6. g = r4
  7. i = r3
  8.  
  9. sef=sec^sec; clf=clc^clc; bfs=bcs^bcs; bfc=bcc^bcc    /fail indicator
  10.  
  11. .globl flush,obuild,putch,iget,kput
  12. .globl generate
  13. .globl cfile,dfile,ofile,input
  14. .globl main,succ,fail,errcom,pbundle,parse,diag
  15. .globl alt,salt,stop,goto
  16. .globl tables,start,end
  17. .globl stkb,stke
  18. .globl ktab
  19. .globl trswitch,trace
  20. .globl x,si,j,k,n,g1,env
  21.  
  22. / begin here
  23. / get arguments from shell
  24. / arg1 is input file
  25. / arg2 is output file (standard output if missing)
  26.  
  27. main:
  28.     dec    (sp)
  29.     beq    3f
  30.     mov    4(sp),0f
  31.     sys    open;0:0;0
  32.     bes    1f
  33.     mov    r0,input
  34.     dec    (sp)
  35.     beq    3f
  36.     mov    6(sp),0f
  37.     sys    creat;0:0;666
  38.     bes    1f
  39.     mov    r0,ofile
  40.  
  41. / set up tables
  42. / initialize stack, for definitions see tmgc.s
  43. / go interpret beginning at "start"
  44. / finish up
  45. 3:
  46.     mov    $stkb,f
  47.     clr    j(f)
  48.     clr    k(f)
  49.     clr    n(f)
  50.     mov    f,g
  51.     add    $g1,g
  52.     mov    $start,r0
  53.     jsr    pc,adv
  54.     jsr    pc,flush
  55. 1:
  56.     sys    unlink;1f
  57.     sys    exit
  58. 1:
  59.         <alloc.d\0>;.even
  60. / fatal processor error
  61. /write a two letter message on diagnostic file
  62. / get a dump
  63.  
  64. errcom:
  65.     mov    dfile,cfile
  66.     jsr    pc,obuild
  67.     mov    $1f,r0
  68.     jsr    pc,obuild
  69.     jsr    pc,flush
  70. stop:
  71.     4
  72. 1:    <--fatal\n\0>;.even
  73.  
  74. / all functions that succeed come here
  75. / test the exit indicator, and leave the rule if on
  76.  
  77. succ:
  78.     inc    succc
  79.     bit    $1,x(f)
  80.     bne    sret
  81. contin:
  82.     inc    continc
  83.     .if tracing
  84.     tst    trswitch
  85.     beq    1f
  86.     mov    $'r,r0
  87.     jsr    pc,trace
  88. 1:
  89.     .endif
  90. / get interpreted instruction
  91. / save its exit bit (bit 0) on stack
  92. / distinguish type of instruction by ranges of value
  93.  
  94.     jsr    pc,iget
  95.     mov    r0,x(f)
  96.     bic    $1,r0
  97. .if ..
  98.     cmp    r0,$..
  99.     blo    1f
  100. .endif
  101.     cmp    r0,$start
  102.     blo    2f
  103.     cmp    r0,$end
  104.     blo    3f
  105.     cmp    r0,$tables
  106.     blo    2f
  107.  
  108. / bad address
  109. 1:
  110.     jsr    r0,errcom
  111.         <bad address in parsing\0>;.even
  112.  
  113. / machine coded function
  114. 2:
  115.     jmp    (r0)
  116.  
  117. / tmg-coded rule, execute and test its success
  118. / bfc = branch on fail clear
  119. 3:
  120.     jsr    pc,adv
  121.     bfc    succ
  122.  
  123. / all functions and rules that fail come here
  124. / if exit bit is on do a fail return
  125. / if following instruction is an alternate (recognized literally)
  126. / do a goto, if a success alternate, do a nop
  127. / otherwise do a fail return
  128.  
  129. fail:
  130.     inc    failc
  131.     bit    $1,x(f)
  132.     bne    fret
  133.     jsr    pc,iget
  134.     mov    r0,x(f)
  135.     bic    $1,r0
  136.     cmp    r0,$alt
  137.     beq    salt
  138.     cmp    r0,$salt
  139.     bne    fret
  140.  
  141. alt:
  142.     tst    (i)+
  143.     br    succ
  144.  
  145. salt:
  146.     jsr    pc,iget
  147.     mov    r0,i
  148.     br    contin
  149.  
  150. goto:
  151.     br    salt
  152.  
  153. / do a success return
  154. / bundle translations delivered to this rule,
  155. / pop stack frame
  156. / restore  interpreted instruction counter (i)
  157. / update input cursor (j) for invoking rule
  158. / update high water mark (k) in ktable
  159. / if there was a translation delivered, add to stack frame
  160. / clear the fail flag
  161.  
  162. sret:
  163.     mov    f,r0
  164.     add    $g1,r0
  165.     jsr    pc,pbundle
  166.     mov    f,g
  167.     mov    (f),f
  168.     mov    si(f),i
  169.     mov    j(g),j(f)
  170.     mov    k(g),k(f)
  171.     tst    r0
  172.     beq    1f
  173.     mov    r0,(g)+
  174. 1:
  175.     clf
  176.     rts    pc
  177.  
  178. / do a fail return
  179. / pop stack
  180. / do not update j or k
  181. / restore interpreted instruction counter
  182.  
  183. fret:
  184.     mov    f,g
  185.     mov    (f),f
  186.     mov    si(f),i
  187.     sef
  188.     rts    pc
  189.  
  190. / diag and parse builtins
  191. / set current file to diagnostic or output
  192. / save and restore ktable water mark around parse-translate
  193. / also current file and next frame pointer (g)
  194. / execute parsing rule
  195.  
  196. diag:
  197.     mov    dfile,r1
  198.     br    1f
  199. parse:
  200.     mov    ofile,r1
  201. 1:
  202.     mov    cfile,-(sp)
  203.     mov    r1,cfile
  204.     mov    k(f),-(sp)
  205.     mov    g,-(sp)
  206.     jsr    pc,iget
  207.     jsr    pc,adv
  208.     bfs    1f
  209. / rule succeeded
  210. / if it delivered translation, put it in ktable and set
  211. / instruction counter for
  212. / translation generator to point there
  213. / go generate
  214.     cmp    g,(sp)+
  215.     ble    2f
  216.     mov    -(g),r0
  217.     jsr    pc,kput
  218.     mov    k(f),i
  219.     neg    i
  220.     add    $ktab,i
  221.     mov    f,-(sp)
  222.     mov    g,f
  223.     clr    x(f)
  224.     jsr    pc,generate
  225.     mov    (sp)+,f
  226.     mov    si(f),i
  227. 2:
  228.     mov    (sp)+,k(f)
  229.     mov    (sp)+,cfile
  230.     jmp    succ
  231. 1:
  232.     mov    (sp)+,g
  233.     mov    (sp)+,k(f)
  234.     mov    (sp)+,cfile
  235.     br    fail
  236.  
  237. / advance stack frame to invoke a parsing rule
  238. / copy  corsor, watr mark, ignored class to new frame
  239. / set intial frame length to default (g1)
  240. / check end of stack
  241. / r0,r1 are new i,environment
  242.  
  243. adv:
  244.     inc    advc
  245.     mov    f,(g)
  246.     mov    i,si(f)
  247.     mov    j(f),j(g)
  248.     mov    k(f),k(g)
  249.     mov    n(f),n(g)
  250.     mov    g,f
  251.     add    $g1,g
  252.     cmp    g,$stke
  253.     bhis    1f
  254.     mov    r0,i
  255.     mov    r1,env(f)
  256.     jmp    contin
  257. 1:
  258.     jsr    r0,errcom
  259.         <stack overflow\0>;.even
  260.  
  261. /pbundle entered with pointer to earliest element of bunlde
  262. /to reduce from the top of stack in r0
  263. /exit with pointer to bundle in r0, or zero if bundle is empty
  264.  
  265. pbundle:
  266.     cmp    r0,g
  267.     blo    1f
  268.     clr    r0    /empty bundle
  269.     rts    pc
  270. 1:
  271.     mov    r0,-(sp)
  272.     mov    r0,r1
  273.     mov    (r1)+,r0
  274.     cmp    r1,g
  275.     beq    2f        /trivial bundle
  276. 1:
  277.     mov    r1,-(sp)
  278.     jsr    pc,kput
  279.     mov    (sp)+,r1
  280.     mov    (r1)+,r0
  281.     cmp    r1,g
  282.     blos    1b
  283.     mov    k(f),r0
  284. 2:
  285.     mov    (sp)+,g
  286.     rts    pc
  287.  
  288. / tmg translation rule interpreter (generator)
  289. / see tmgc.s for definitions
  290.  
  291. tracing = 1
  292. f = r5
  293. .globl x,si,ek,ep,ek.fs,ep.fs,fs
  294. .globl trswitch,trace
  295. .globl start,end,tables,ktab,ktat
  296. .globl errcom
  297. .globl generate,.tp
  298. i = r3
  299.  
  300. / if exit bit is on pop stack frame restore inst counter and return
  301.  
  302. generate:
  303. bit    $1,x(f)
  304.     beq    gcontin
  305.     sub    $fs,f
  306.     mov    si(f),i
  307.     rts    pc
  308. gcontin:
  309.     .if tracing
  310.     tst    trswitch
  311.     beq    1f
  312.     mov    $'g,r0
  313.     jsr    pc,trace
  314. 1:
  315.     .endif 
  316. / get interpreted instruction, decode by range of values
  317.  
  318.     mov    (i)+,r0
  319.     mov    r0,x(f)
  320.     bic    $1,r0
  321. .if ..
  322.     cmp    r0,$..
  323.     blo    badadr
  324. .endif
  325.     cmp    r0,$start
  326.     blo    gf
  327.     cmp    r0,$end
  328.     blo    gc
  329.     cmp    r0,$tables
  330.     blo    gf
  331.     neg    r0
  332.     cmp    r0,$ktat
  333.     blo    gk
  334. badadr:
  335.     jsr    r0,errcom
  336.         <bad address in translation\0>;.even
  337.  
  338. / builtin  translation function
  339. gf:
  340.     jmp    (r0)
  341.  
  342. / tmg-coded translation subroutine
  343. / execute it in current environment
  344. gc:
  345.     mov    i,si(f)
  346.     mov    r0,i
  347.     mov    ek(f),ek.fs(f)
  348.     mov    ep(f),ep.fs(f)
  349.     add    $fs,f
  350.     jsr    pc,gcontin
  351.     br    generate
  352.  
  353. / delivered compound translation
  354. / instruction counter is in ktable
  355. / set the k environment for understanding 1, 2 ...
  356. / to designate this frame
  357. gk:
  358.     mov    f,ek(f)
  359.     add    $ktab,r0
  360.     mov    r0,i
  361.     br    gcontin
  362.  
  363. / execute rule called for by 1 2 ...
  364. / found relative to instruction counter in the k environment
  365. / this frame becomes th p environment for
  366. / any parameters passed with this invocation
  367. / e.g. for 1(x) see also .tq
  368. .tp:
  369.     movb    (i)+,r0
  370.     movb    (i)+,r2
  371.     inc    r0
  372.     asl    r0
  373.     mov    i,si(f)
  374.     mov    f,ep.fs(f)
  375.     mov    ek(f),r1
  376.     mov    si(r1),i
  377.     sub    r0,i
  378.     add    $fs,f
  379.     mov    f,ek(f)
  380.     asl    r2
  381.     beq    2f
  382. /element is 1.1, 1.2, .. 2.1,...
  383.     mov    (i),i
  384.     neg    i
  385.     bge    1f
  386.     jsr    r0,errcom
  387.         <not a bundle\0>;.even
  388. 1:
  389.     cmp    i,$ktat
  390.     bhis    badadr
  391.     add    $ktab,i
  392.     sub    r2,i
  393. 2:
  394.     jsr    pc,gcontin
  395.     br    generate
  396.  
  397. / tmg output routines/ and iget
  398. f = r5
  399. i = r3
  400. .globl env,si
  401. .globl errcom
  402. .globl cfile,lfile
  403. .globl putch,obuild,iget,flush
  404. .globl outb,outt,outw
  405. .globl start
  406.  
  407. / adds 1 or 2 characters in r0 to output
  408.  
  409. putch:
  410.     clr    -(sp)
  411.     mov    r0,-(sp)
  412.     mov    sp,r0
  413.     jsr    pc,obuild
  414.     add    $4,sp
  415.     rts    pc
  416.  
  417. / r0 points to string to put out  on current output file (cfile)
  418. / string terminated by 0
  419. / if last file differed from current file, flush output buffer first
  420. / in any case flush output buffer when its write pointer (outw)
  421. / reaches its top (outt)
  422.  
  423. obuild:
  424.     cmp    cfile,lfile
  425.     beq    1f
  426.     mov    r0,-(sp)
  427.     jsr    pc,flush
  428.     mov    (sp)+,r0
  429.     mov    cfile,lfile
  430. 1:
  431.     mov    outw,r1
  432. 1:
  433.     tstb    (r0)
  434.     beq    1f
  435.     movb    (r0)+,outb(r1)
  436.     inc    r1
  437.     mov    r1,outw
  438.     cmp    r1,$outt
  439.     blt    1b
  440.     mov    r0,-(sp)
  441.     jsr    pc,flush
  442.     mov    (sp)+,r0
  443.     br    obuild
  444. 1:
  445.     rts    pc
  446.  
  447. / copy output buffer onto last output file and clear buffer
  448.  
  449. flush:
  450.     mov    outw,0f
  451.     mov    lfile,r0
  452.     sys    write;outb;0:0
  453.     clr    outw
  454.     rts    pc
  455.  
  456.  
  457. / get interpreted instruction for a parsing rule
  458. / negative instruction is a pointer to a parameter in this
  459. / stack fromae, fetch that instead
  460. / put environment pointer in r1
  461.  
  462. iget:
  463.     mov    f,r1
  464.     mov    (i)+,r0
  465.     bge    2f
  466.     mov    r0,-(sp)    /save the exit bit 
  467.     bic    $-2,(sp)
  468.     bic    (sp),r0
  469. 1:            /chase parameter
  470.     mov    env(r1),r1
  471.     add    si(r1),r0
  472.     mov    (r0),r0
  473.     blt    1b
  474.     mov    env(r1),r1
  475.     bis    (sp)+,r0
  476. 2:
  477.     rts    pc
  478. /there followeth the driving tables
  479. start:
  480.  
  481. .data
  482. succc:    0
  483. continc:    0
  484. failc:    0
  485. advc:    0
  486. .text
  487.