.nlist .enabl lc,crf .mcall .exit .macro arggen a,b,c,d,e,f,g,h,i,j,k,l,m,n .if nb a .word a arggen b,c,d,e,f,g,h,i,j,k,l,m,n .iff .mexit .endc .endm arggen .macro print arg .if df arg .globl writec jsr r5, writec arg .iff .list .ERROR Undefined argument (arg) in PRINT .nlist .endc .endm print .macro accept no,arg .if df arg .if gt no .globl readc jsr r5, readc .word no,arg .iff .list .ERROR Illegal argument (no) in ACCEPT .nlist .endc .iff .list .ERROR Undefined argument (arg) in ACCEPT .nlist .endc .endm accept .macro readln a,b,c,d,e,f,g,h,i,j,k,l,m,n .narg $no$ .if gt $no$ .globl readd jsr r5, readd .word $no$ arggen a,b,c,d,e,f,g,h,i,j,k,l.m,n .iff .list .ERROR READLN must have an argument .nlist .endc .endm readln .macro writeln a,b,c,d,e,f,g,h,i,j,k,l,m,n .narg $no$ .if gt $no$ .globl writed jsr %5, writed .word $no$ arggen a,b,c,d,e,f,g,h,i,j,k,l,m,n .iff .list .ERROR Writeln Must have an argument .nlist .endc .endm writeln .list SEG:: ;## 1 # 0 ## PROCEDURE SEG,GLOBAL NUL = 0 ;## 2 # 0 ## NUL = 0 ; ;called from fortran by the call ; call seg (instring,outstring,from,to) ; ; where instring= the input string (which is not changed) ; outstring= the output string to contain the ; segment from the instring ; from = pointer to first character of the segment ; wanted ; to = pointer to the last character of the segment ; wanted. ; ; from must be <= to ; ; cmpb (R5),#4 ;## 18 # 0 ## IFB (R5) = #4 THEN; we have a legal list of arguments bEQ ll$2 jmp ll$1 ll$2: tst (5)+ ;## 19 # 1 ## PROBE (5)+; skip into argument list mov (R5)+,R0 ;## 20 # 1 ## LET R0 := (R5)+; fetch instring address mov (5)+,R1 ;## 21 # 1 ## LET R1 := (5)+; fetch outstring address mov @(5)+,R2 ;## 22 # 1 ## LET R2 := @(5)+; fetch 'from' mov @(5)+,R3 ;## 23 # 1 ## LET R3 := @(5)+; fetch 'to' cmp R2,R3 ;## 24 # 1 ## IF R2 <= R3 THEN bLE ll$4 jmp ll$3 ll$4: add R0,R2 ;## 25 # 2 ## LET R2 := R2 + R0 - #1; add offsets to pointers dec R2 add R0,R3 ;## 26 # 2 ## LET R3 := R3 + R0 - #1 dec R3 ll$5: ;## 27 # 2 ## WHILE R2 <= R3 DO; shovel .... cmp R2,R3 bLE ll$8 jmp ll$7 ll$7: jmp ll$6 ll$8: movb (R2)+,(R1)+ ;## 28 # 3 ## LETB (R1)+ := (R2)+ jmp ll$5 ;## 29 # 2 ## END; shovel ll$6: ll$3: ;## 30 # 1 ## FI; if we have an actual string to move movb #,(R1) ;## 31 # 1 ## LETB (R1) := #; put a null at end of string rts pc ;## 32 # 1 ## RETURN; to caller ll$1: ;## 33 # 0 ## FI; if have 4 arguments TRAP 0 ;## 34 # 0 ## TRAP 0 ;## 35 # 0 ## .END ;SUPERMAC error(s) detected: 0 ; 1 0 0 0 7 0 1 0 0 2 ; 38 0 2 20 4 1 1 4 20 8 ; 0 8 0 0 0 20 0 0 121 0 ; 0 1 1 0 2 0 0 1 35 20 ; 6 1 0 0 3 1 3 0 0 0 ; 0 0 0 0 0 0 0 0 0 0 ; 0 0 0 0 0 0 0 0 0 0 ; 0 0 0 0 0 0 .END