Oakland CPM Archive

home *** CD-ROM | disk | FTP | other *** search

/ Oakland CPM Archive / oakcpm.iso / sigm / vol092 / litl-ada.prn < prev next >

Wrap

Text File | 1984-04-29 | 43.5 KB | 1,174 lines

L/1 Interpreter Source list August 10, 1980 Copywrite 1980 by Ralph E. Kenyon Jr. page 1 Abstract Systems, etc. Ph 413-354-7875 RFD Lower Prospect Hill Chester MA, 01011 ;Little-Ada L/0 machine interperter ;Edited June 21, 1980 ;Copyright 1980 by Ralph E. Kenyon Jr. ;Version 1547 Re-designated L/1 Jan 81 ;Stripped down, no debug version REFS SYSTEM.SY ;Library file REF Warm ;Warmstart REF WH0 ;Consol Char in REF WH1 ;Consol Char out REF Msg ;Message writer REF USER ;Start of user memory REF MEMTOP ;Last good memory REF Ret ;Return from overlay REF Dio ;Disk In/Out REF Err ;System error handler REF FILE ;File data buffer REF Ovrto ;Overlay handler REF CMPTR ;Command buffer pointer REF Ioret ;Return from Interupt REFS <#>L0CODE.SY ;Open L/0 code MACRO Library REF L0CODE ;Macro which defines all L/0 code macros. 000D CR EQU 13 3200 ORG USER 3200 IDNT $,$ ;$ is current value PC 3200 C32F3A JMP Start 3203 C31135 JMP GO L0CODE 0000 LIST 0 3206 0D446976 DBZ DB CR,'Division by zero not defined!',CR,0 320A 6973696F 320E 6E206279 3212 207A6572 3216 6F206E6F 321A 74206465 321E 66696E65 3222 64210D00 3226 Inst DS 1 ;Instruction register 3227 Base DS 2 ;Base register 3229 Static DS 2 ;Static link conversion register 322B Level DS 1 ;Level register 322C AR1 DS 2 ;Arithemetic storage 1 322E AR2 DS 2 ;Arithemetic storage 2 3230 AR3 DS 2 ;Arithemetic storage 3 3232 TMStack DS 2 ;Stack start L/1 Interpreter Source list August 10, 1980 Copywrite 1980 by Ralph E. Kenyon Jr. page 2 3234 FDB DS 44 ;File descriptor buffer 3260 IFD DS 1 ;Input file drive 3261 IFA DS 2 ;Input file disk address 3263 IFS DS 2 ;Input file disk sector 3265 IFP DS 2 ;Input file buffer pointer 3267 IFB DS 256 ;Input file buffer 3367 OFD DS 1 ;Output file drive 3368 OFA DS 2 ;Output file disk address 336A OFS DS 2 ;Output file disk sector 336C OFP DS 2 ;Output file buffer pointer 336E OFB DS 256 ;Output file buffer 346E Flag DS 1 ;Output file in use flag 346F 01 IFflg DB 1 ;initialize flag 3470 01 OFflg DB 1 ;initialize flag 3471 0A Fetch LDAX B ;Instruction fetch cycle 3472 03 INX B 3473 322632 STA Inst 3476 B7 ORA A 3477 C9 RET 3478 73 Push MOV M,E ;DE to S(t) 3479 2B DCX H ;t+1 to HL 347A 72 MOV M,D 347B 2B DCX H 347C C9 RET 347D 23 Pop INX H ;S(t) to DE 347E 56 MOV D,M ;t-1 to HL 347F 23 INX H 3480 5E MOV E,M 3481 C9 RET 3482 F5 MinDE PUSH PSW ;Two's complement 3483 7A MOV A,D ;of DE. All other 3484 2F CMA ;registers preserved. 3485 57 MOV D,A 3486 7B MOV A,E 3487 2F CMA 3488 5F MOV E,A 3489 13 INX D 348A F1 POP PSW 348B C9 RET 348C E5 CONV PUSH H ;Requires T in DE 348D CD8234 CALL MinDE ;(Static) 3490 2A3232 LHLD TMStack 3493 19 DAD D ;<[(TMStack)-(Static)] 3494 7C MOV A,H ;We're going to divide by 2 3495 BC CMP H ;(Just reset carry) L/1 Interpreter Source list August 10, 1980 Copywrite 1980 by Ralph E. Kenyon Jr. page 3 3496 1F RAR ;Puts lo bit in carry 3497 57 MOV D,A ;Right shifted by 1 3498 7D MOV A,L ;Lo byte 3499 1F RAR ;Carry goes into hi bit 349A 5F MOV E,A ;(16 bits right shift) 349B E1 POP H 349C C9 RET ;Result in DE ;This section computes the static link ;by finding the ltack position base for ;L levels down. 349D F5 GStL PUSH PSW 349E E5 PUSH H 349F 3A2632 LDA Inst ;get & stow level 34A2 E60F GStL1 ANI 0FH 34A4 2A2732 LHLD Base ;get & stow base 34A7 222932 SHLD Static 34AA C3C534 JMP BASE 34AD 2A2932 BASE1 LHLD Static ;get base 34B0 EB XCHG 34B1 2A3232 LHLD TMStack 34B4 13 INX D ;We need to be above by 1 34B5 CD8234 CALL MinDE 34B8 19 DAD D ;(MEMTOP-2*T) 34B9 19 DAD D ;stack address now in hl 34BA CD7D34 CALL Pop ;Get S(S(t)) 34BD EB XCHG 34BE 222932 SHLD Static 34C1 3A2B32 LDA Level ;get level 34C4 3D DCR A 34C5 322B32 BASE STA Level 34C8 C2AD34 JNZ BASE1 34CB EB XCHG ;Returns static level in DE 34CC E1 POP H 34CD F1 POP PSW 34CE C9 RET 34CF 1E02 Out2 MVI E,2 ;Output file already exists 34D1 C3D634 JMP Out0 34D4 1E03 Out3 MVI E,3 ;Input file not specified 34D6 1607 Out0 MVI D,7 34D8 C30F04 Out JMP Err 34DB 3EE0 Gf MVI A,0E0H 34DD CD1204 Gf1 CALL Ovrto 34E0 47666964 DB 'Gfid' 34E4 C9 RET ;Parameters for Dio set up by start code ;Here's where we get the file to be ;interpretered 34E5 CD0604 GETP CALL Dio ;Go get it. L/1 Interpreter Source list August 10, 1980 Copywrite 1980 by Ralph E. Kenyon Jr. page 4 34E8 DAD834 JC Out ;Something Wrong! 34EB 212F3A LXI H,Pgmaddr ;get the program 34EE E5 PUSH H 34EF C1 POP B ;Set TMPC to first byte 34F0 2A3232 LHLD TMStack ;Set initialize TMSP 34F3 110000 LXI D,0 ;First position on stack for 34F6 CD7834 CALL Push ;Character in/out 34F9 CD7834 CALL Push ;Static link 34FC 13 INX D 34FD EB XCHG 34FE 222732 SHLD Base ;set Base 1st 3501 EB XCHG 3502 CD7834 CALL Push ;Dynamic link same 3505 112E3A LXI D,Origin ;addr of that 'hlt' byte 3508 CD7834 CALL Push 350B CDFF37 CALL INB 350E CD5039 CALL OUTB ;This routine sets itself up as a return address 3511 E5 GO PUSH H ;Return to here 3512 211135 LXI H,GO 3515 E3 XTHL ;Put our addr on stack 3516 CD7134 CALL Fetch 3519 17 RAL 351A D2A635 JNC branch ;0 means br or bnz 351D 17 RAL 351E D26935 JNC oprlic 3521 17 RAL 3522 D8 RC ;111XXXXX is NOP 3523 CD9D34 CALL GStL ;For both lad & call 3526 17 RAL ;Now which one 3527 DA3C35 JC Call ;do we have? ;Here we have to get the address from ;the program immediate data (two bytes) 352A E5 Lad PUSH H 352B 2A2932 LHLD Static 352E CD7134 CALL Fetch 3531 57 MOV D,A ;Address hi byte 3532 CD7134 CALL Fetch 3535 5F MOV E,A ;Address lo byte 3536 19 DAD D ;Add in the stack base 3537 EB XCHG ;put it in DE 3538 E1 POP H 3539 C37834 JMP Push ;Let push return ;This routine puts links on stack ;followed by return address 353C E5 Call PUSH H ;We need TMSP later 353D EB XCHG 353E 2A2932 LHLD Static L/1 Interpreter Source list August 10, 1980 Copywrite 1980 by Ralph E. Kenyon Jr. page 5 3541 EB XCHG 3542 CD7834 CALL Push ;Static link first 3545 EB XCHG 3546 2A2732 LHLD Base 3549 EB XCHG 354A CD7834 CALL Push ;Dynamic link second 354D E3 XTHL ;TMSP to stack 354E EB XCHG 354F CD8C34 CALL CONV 3552 EB XCHG 3553 222732 SHLD Base ;Set new base 3556 CD7134 CALL Fetch ;lets get that address 3559 57 MOV D,A 355A CD7134 CALL Fetch 355D 5F MOV E,A 355E 212F3A LXI H,Pgmaddr 3561 19 DAD D 3562 E3 XTHL ;Addr to top of stack 3563 C5 PUSH B 3564 D1 POP D 3565 C1 POP B 3566 C37834 JMP Push ;return address 3569 17 oprlic RAL ;Check next bit for oprlic 356A DA8135 JC Lic ;For opr, we must get last 5 bits from inst ;We'll use a computed goto to get the ;routine for the sub-operation. 356D 3A2632 opr LDA Inst 3570 E61F ANI 1FH 3572 87 ADD A ;Times 2 3573 5F MOV E,A 3574 1600 MVI D,0 3576 E5 PUSH H ;save TMSP 3577 21CB35 LXI H,Jtbl ;jmp table 357A 19 DAD D ;add position 357B 5E MOV E,M 357C 23 INX H 357D 56 MOV D,M 357E EB XCHG ;addr to HL 357F E3 XTHL ;addr to stack 3580 C9 RET ;Jump to addr ;Now we've got to sort out the number of ;bytes used for the constant in this lic 3581 17 Lic RAL 3582 DA8F35 JC Lic1 3585 3A2632 LDA Inst ;1 byte 3588 E60F ANI 0FH 358A 1600 MVI D,0 358C C3A235 JMP lic4 L/1 Interpreter Source list August 10, 1980 Copywrite 1980 by Ralph E. Kenyon Jr. page 6 358F 17 Lic1 RAL 3590 DA9B35 JC lic2 3593 3A2632 LDA Inst ;2 byte 3596 E607 ANI 7 3598 C39E35 JMP lic3 359B CD7134 lic2 CALL Fetch ;3 byte 359E 57 lic3 MOV D,A 359F CD7134 CALL Fetch 35A2 5F lic4 MOV E,A 35A3 C37834 JMP Push ;let push RET for us 35A6 17 branch RAL 35A7 D2B935 JNC Br 35AA CD7D34 CALL Pop 35AD 7A MOV A,D 35AE B7 ORA A 35AF C2B935 JNZ Br ;(bnz) 35B2 83 ADD E 35B3 C2B935 JNZ Br ;(bnz) 35B6 C37134 JMP Fetch ;Skip this byte ;let Fetch return 35B9 3A2632 Br LDA Inst 35BC E63F ANI 3FH ;Kill opcode 35BE 57 MOV D,A ;Hi addr 35BF CD7134 CALL Fetch ;rest of addr 35C2 5F MOV E,A ;Lo addr 35C3 E5 PUSH H 35C4 212F3A LXI H,Pgmaddr ;Adjust for program 35C7 19 DAD D ;load address 35C8 E3 XTHL 35C9 C1 POP B 35CA C9 RET 35CB 0B36 Jtbl DW Halt ;0 ; Halt closes both the input and the ; output files before invoking Exec. ; The input and output file setup routines ; are restored to IFR and OFR also. 35CD 1636 DW addsub ;1 35CF 1636 DW addsub ;2 35D1 2D36 DW muldiv ;3 35D3 2D36 DW muldiv ;4 35D5 F236 DW Mod ;5 35D7 3637 DW Neg ;6 35D9 3F37 DW Not ;7 35DB 8837 DW Sete ;8 35DD A837 DW Setlg ;9 35DF A837 DW Setlg ;A 35E1 5737 DW Swap ;B 35E3 6837 DW retn ;C 35E5 CB37 DW Rav ;D L/1 Interpreter Source list August 10, 1980 Copywrite 1980 by Ralph E. Kenyon Jr. page 7 35E7 DF37 DW Sto ;E 35E9 F637 DW inc ;F 35EB FF37 IFR DW INB ;10 ; INB sets up the input file data for Dio ; and puts the address of Inb into IFR. ; If a file is not selected, INB puts the ; address of Cinb into IFR (input from consol) 35ED 5039 OFR DW OUTB ;11 ; OUTB sets up the output file data for Dio ; and puts the address of Outb into OFR. ; If a file is not selected, OUTB puts the ; address of Coutb into OFR (output to consol) ;These remaining are all treated as nop 35EF 2805 DW Ret ;12 insurance 35F1 2805 DW Ret ;13 35F3 2805 DW Ret ;14 35F5 2805 DW Ret ;15 35F7 2805 DW Ret ;16 35F9 2805 DW Ret ;17 35FB 2805 DW Ret ;18 35FD 2805 DW Ret ;19 35FF 2805 DW Ret ;1A 3601 2805 DW Ret ;1B 3603 2805 DW Ret ;1C 3605 2805 DW Ret ;1D 3607 2805 DW Ret ;1E 3609 2805 DW Ret ;1F 360B CDE539 Halt CALL TURNOFF ;Close open output file 360E 21FF37 LXI H,INB ;Restore Input file 3611 22EB35 SHLD IFR ;Open sequence 3614 D1 POP D ;Clean up stack 3615 C9 RET 3616 CD7D34 addsub CALL Pop ;S(t) 3619 D5 PUSH D 361A CD7D34 CALL Pop ;S(t-1) 361D E3 XTHL ;S(t) to HL 361E EB XCHG ;S(t) to DE 361F 3A2632 LDA Inst 3622 E602 ANI 2 ;is it a subtract? 3624 C48234 CNZ MinDE 3627 19 DAD D ;S(t-1)-S(t) IN HL 3628 EB XCHG 3629 E1 POP H ;Get TMSP back 362A C37834 JMP Push ;let push return for us 362D CD7D34 muldiv CALL Pop 3630 EB XCHG L/1 Interpreter Source list August 10, 1980 Copywrite 1980 by Ralph E. Kenyon Jr. page 8 3631 222C32 SHLD AR1 3634 EB XCHG 3635 CD7D34 CALL Pop 3638 EB XCHG 3639 222E32 SHLD AR2 363C 3A2632 LDA Inst 363F E604 ANI 4 ;not multiply? 3641 CC4E36 CZ MULT 3644 C49936 CNZ DIVD 3647 2A3032 LHLD AR3 364A EB XCHG 364B C37834 JMP Push ;let push return for us 364E F5 MULT PUSH PSW ;16 bit multiply 364F C5 PUSH B ;with no overflow test 3650 D5 PUSH D ;returns product mod 10000H 3651 E5 PUSH H 3652 2A2C32 LHLD AR1 3655 7C MOV A,H 3656 B7 ORA A 3657 C25F36 JNZ MULT1 365A 85 ADD L 365B CA9036 JZ MULT7 365E EB XCHG 365F 2A2E32 MULT1 LHLD AR2 3662 7C MOV A,H 3663 B7 ORA A 3664 C26B36 JNZ MULT2 3667 85 ADD L 3668 CA9036 JZ MULT7 366B 4C MULT2 MOV C,H ;save hi byte 366C 7D MOV A,L ;do lo byte 366D 210000 LXI H,0 3670 0608 MVI B,8 3672 0F MULT3 RRC 3673 D27736 JNC MULT4 3676 19 DAD D 3677 EB MULT4 XCHG 3678 29 DAD H 3679 EB XCHG 367A 05 DCR B 367B C27236 JNZ MULT3 367E 79 MOV A,C ;now do hi byte 367F 0608 MVI B,8 3681 0F MULT5 RRC 3682 D28636 JNC MULT6 3685 19 DAD D 3686 EB MULT6 XCHG 3687 29 DAD H 3688 EB XCHG 3689 05 DCR B 368A C28136 JNZ MULT5 368D C39336 JMP MULT8 3690 210000 MULT7 LXI H,0 L/1 Interpreter Source list August 10, 1980 Copywrite 1980 by Ralph E. Kenyon Jr. page 9 3693 223032 MULT8 SHLD AR3 3696 C36400 JMP Ioret 3699 F5 DIVD PUSH PSW 369A C5 PUSH B 369B D5 PUSH D 369C E5 PUSH H 369D 010000 LXI B,0 ;Result goes here 36A0 2A2C32 LHLD AR1 36A3 7C MOV A,H ;lets see if 36A4 B7 ORA A ;the idiot wants 36A5 C2AC36 JNZ DIVD1 ;to divide by 36A8 85 ADD L ;zero. 36A9 CAE536 JZ DBZER ;He does! 36AC EB DIVD1 XCHG ;nope, so get 36AD 2A2E32 LHLD AR2 ;dividend 36B0 7A MOV A,D ;If it's 36B1 B7 ORA A ;zero 36B2 C2BF36 JNZ DIVD2 ;then 36B5 85 ADD E ;result's 36B6 C2BF36 JNZ DIVD2 ;also 36B9 210000 DIVD7 LXI H,0 ;zero 36BC C3DF36 JMP DIVD6 36BF 7C DIVD2 MOV A,H 36C0 BA CMP D 36C1 DADD36 JC DIVD4 36C4 CACB36 JZ DIVD3 36C7 03 INX B 36C8 C3D436 JMP SUBT 36CB 7D DIVD3 MOV A,L 36CC BB CMP E 36CD DADD36 JC DIVD4 36D0 03 INX B 36D1 CADD36 JZ DIVD4 36D4 D5 SUBT PUSH D 36D5 CD8234 CALL MinDE 36D8 19 DAD D 36D9 D1 POP D 36DA C3BF36 JMP DIVD2 36DD C5 DIVD4 PUSH B 36DE E1 POP H 36DF 223032 DIVD6 SHLD AR3 36E2 C36400 JMP Ioret 36E5 CDEB36 DBZER CALL DBZ1 36E8 C3B936 JMP DIVD7 36EB 210632 DBZ1 LXI H,DBZ 36EE CD0C04 CALL Msg 36F1 C9 RET 36F2 CD7D34 Mod CALL Pop ;S(t) to DE L/1 Interpreter Source list August 10, 1980 Copywrite 1980 by Ralph E. Kenyon Jr. page 10 36F5 D5 PUSH D ;S(t) to top of stack 36F6 CD7D34 CALL Pop ;S(t-1) to DE 36F9 E3 XTHL ;S(t) to HL 36FA 7C MOV A,H ;lets see if 36FB B7 ORA A ;the idiot wants 36FC C20937 JNZ Mod1 ;to divide by 36FF 85 ADD L ;zero. 3700 C20937 JNZ Mod1 3703 CDEB36 CALL DBZ1 3706 C32D37 JMP Mod3 ;He does! 3709 7A Mod1 MOV A,D ;see if we 370A B7 ORA A ;start with 370B C21D37 JNZ TEST ;zero 370E 83 ADD E 370F C21D37 JNZ TEST 3712 C32D37 JMP Mod3 3715 EB SUBTR XCHG 3716 D5 PUSH D ;Save 3717 CD8234 CALL MinDE 371A 19 DAD D ;Add -DE 371B D1 POP D ;Restore 371C EB XCHG 371D 7A TEST MOV A,D ;Hi byte of S(t) 371E BC CMP H 371F DA3037 JC Done ;Hi byte of S(t-1) ;<Hi byte of S(t) 3722 C21537 JNZ SUBTR ;its bigger 3725 7B MOV A,E ;It's equal so 3726 BD CMP L ;Check lo byte 3727 DA3037 JC Done 372A C21537 JNZ SUBTR ;its bigger 372D 110000 Mod3 LXI D,0 ;its equal 3730 EB Done XCHG 3731 E3 XTHL 3732 D1 POP D 3733 C37834 JMP Push ;let push return for us 3736 CD7D34 Neg CALL Pop ;S(t) to DE 3739 CD8234 CALL MinDE 373C C37834 JMP Push ;DE to S(t) let push ret 373F CD7D34 Not CALL Pop ;look 3742 7A MOV A,D ;hi byte 3743 B7 ORA A ;set flags 3744 C25137 JNZ Not2 3747 83 Not1 ADD E ;lo byte 3748 C25137 JNZ Not2 374B 110100 LXI D,1 ;its Zero so change result 374E C37834 JMP Push 3751 110000 Not2 LXI D,0 3754 C37834 JMP Push ;onto stack let ;push ret for us L/1 Interpreter Source list August 10, 1980 Copywrite 1980 by Ralph E. Kenyon Jr. page 11 3757 CD7D34 Swap CALL Pop ;S(t) 375A D5 PUSH D ;to TOS 375B CD7D34 CALL Pop ;S(t-1) to DE 375E E3 XTHL ;S(t) TO HL, t-1 to TOS 375F EB XCHG ;S(t) to DE, S(t-1) to HL 3760 E3 XTHL ;t-1 to HL, S(t-1) to TOS 3761 CD7834 CALL Push ;S(t-1) to TOS 3764 D1 POP D ;S(t-1) to DE 3765 C37834 JMP Push ;S(t-1) to TMS ;let push return for us. 3768 2A2732 retn LHLD Base 376B 110300 LXI D,3 376E 19 DAD D 376F 29 DAD H 3770 EB XCHG 3771 CD8234 CALL MinDE 3774 2A3232 LHLD TMStack 3777 19 DAD D 3778 CD7D34 CALL Pop ;TMPC 377B D5 PUSH D 377C C1 POP B 377D CD7D34 CALL Pop ;Dynamic link 3780 EB XCHG 3781 222732 SHLD Base 3784 EB XCHG 3785 23 INX H ;We don't need that 3786 23 INX H ;static link now 3787 C9 RET 3788 CD7D34 Sete CALL Pop 378B D5 PUSH D 378C CD7D34 CALL Pop 378F E3 XTHL 3790 7A MOV A,D 3791 BC CMP H 3792 C2A137 JNZ SETE1 3795 7B MOV A,E 3796 BD CMP L 3797 C2A137 JNZ SETE1 379A 110100 LXI D,1 ;they're equal 379D E1 POP H 379E C37834 JMP Push ;let push return for us 37A1 110000 SETE1 LXI D,0 37A4 E1 POP H 37A5 C37834 JMP Push ;let push return for us 37A8 CD7D34 Setlg CALL Pop 37AB D5 PUSH D ;S(t) to TOS 37AC CD7D34 CALL Pop ;S(t-1) to DE 37AF E3 XTHL ;S(t) to HL 37B0 3A2632 LDA Inst L/1 Interpreter Source list August 10, 1980 Copywrite 1980 by Ralph E. Kenyon Jr. page 12 37B3 E602 ANI 2 ;Setgt? 37B5 CAB937 JZ Set1 37B8 EB XCHG ;Reverse for Setgt 37B9 CD8234 Set1 CALL MinDE ;-S(t-1) 37BC 19 DAD D ;Want 0<S(t)-S(t-1) 37BD 2B DCX H ;Sign test uses >= 0 37BE 7C MOV A,H ;Look at sign 37BF B7 ORA A ;Set flags 37C0 E1 POP H ;TMSP 37C1 110100 LXI D,1 ;Assume true 37C4 F2C837 JP Set2 ;Jump if true 37C7 1B DCX D ;Falls thru if false 37C8 C37834 Set2 JMP Push ;Let Push return for us ;Note: RAV assumes that the address on the stack ;is a relative address from the TM stack pointer ;with 1 for each 16 bit push or pop. We multiply ;the two's complement by 2 and add it to ;the address in TMStack (Top of memory) 37CB CD7D34 Rav CALL Pop ;Get S(t) 37CE E5 PUSH H ;Save SP 37CF 2A3232 LHLD TMStack 37D2 13 INX D ;We need to be above by 1 37D3 CD8234 CALL MinDE 37D6 19 DAD D ;(MEMTOP-2*T) 37D7 19 DAD D ;stack address now in hl 37D8 CD7D34 CALL Pop ;Get S(S(t)) 37DB E1 POP H ;Restore TMSP 37DC C37834 JMP Push ;S(t):=S(S(t)) 37DF CD7D34 Sto CALL Pop ;S(t) to be stowed 37E2 D5 PUSH D ;save it 37E3 CD7D34 CALL Pop ;address to stow S(t) in 37E6 E3 XTHL ;(We'll want S(t) first) 37E7 E5 PUSH H ;Need to use HL 37E8 CD8234 CALL MinDE ;Convert Stack 37EB 2A3232 LHLD TMStack ;address 37EE 19 DAD D ;(MEMTOP-2*T) 37EF 19 DAD D ;stack address now in hl 37F0 D1 POP D ;Get S(t) 37F1 CD7834 CALL Push ;S(S(T-1)):=S(T) 37F4 E1 POP H ;T-2 to TMSP 37F5 C9 RET 37F6 CD7D34 Inc CALL Pop ;S(t) to de, t-1 in HL 37F9 CD8234 CALL MinDE 37FC 19 DAD D 37FD 19 DAD D ;S(t)+t-1 to HL 37FE C9 RET 37FF E5 INB PUSH H ;Save VMSP 3800 C5 PUSH B ;Save VMPC 3801 216F38 LXI H,Ifpr ;get one from him. L/1 Interpreter Source list August 10, 1980 Copywrite 1980 by Ralph E. Kenyon Jr. page 13 3804 11CB2D IFR1 LXI D,FILE ;File descriptor buffer 3807 014441 LXI B,'AD' ;Default file extension 380A CDDB34 CALL Gf 380D D28C38 JNC IFR2 ;Gfid found the file ;so go read it 3810 AF XRA A ;Checks for error 3811 82 ADD D ;code 0503H 3812 FE05 CPI 5 3814 C20F04 JNZ Err ;Wrong one 3817 83 ADD E 3818 FE08 CPI 8 ;adds up to 8 381A C20F04 JNZ Err ;No good! 381D 212638 LXI H,Cinb ;Set up to get input 3820 22EB35 SHLD IFR ;from the consol 3823 C1 POP B ;VMPC 3824 E1 POP H ;VMSP 3825 C9 RET ; Additional inputs jump to here 3826 CD200C Cinb CALL WH0 ;We're inputting from 3829 E5 PUSH H ;the consol 382A 2A3232 LHLD TMStack ;Where it goes 382D 77 MOV M,A ;Put it in 382E E1 POP H ;VMSP 382F C9 RET 3830 0D546865 Ifprn DB CR,'The input file''s empty.' 3834 20696E70 3838 75742066 383C 696C6527 3840 7320656D 3844 7074792E 3848 0D576861 DB CR,'What''s the continuation file''s name? ',0 384C 74277320 3850 74686520 3854 636F6E74 3858 696E7561 385C 74696F6E 3860 2066696C 3864 65277320 3868 6E616D65 386C 3F2000 386F 57686174 Ifpr DB 'What''s the input file name? ',0 3873 27732074 3877 68652069 387B 6E707574 387F 2066696C 3883 65206E61 3887 6D653F20 388B 00 388C 21CB2D IFR2 LXI H,FILE ;READ starts here L/1 Interpreter Source list August 10, 1980 Copywrite 1980 by Ralph E. Kenyon Jr. page 14 388F 7E MOV A,M 3890 E607 ANI 7 ;trim down to drive no. 3892 326032 STA IFD ;Drive number 3895 23 INX H 3896 7E MOV A,M ;FDE flag byte 3897 E61F ANI 1FH ;trim to file size 3899 C603 ADI 3 ;point past extension 389B 5F MOV E,A ;Put into DE 389C 1600 MVI D,0 389E 19 DAD D ;Add to Address in HL 389F EB XCHG ;FDA pointer now in DE 38A0 216132 LXI H,IFA ;Where the addresses go 38A3 0E04 MVI C,4 ;4 bytes to copy 38A5 1A CIFD LDAX D ;Get the data 38A6 77 MOV M,A ;from the FDB (FILE) 38A7 23 INX H ;and copy into the 38A8 13 INX D ;areas for our Dio 38A9 0D DCR C ;routines 38AA C2A538 JNZ CIFD ;More to copy 38AD 216733 LXI H,IFB+100H ;Reset the 38B0 226532 SHLD IFP ;buffer pointer too 38B3 21BC38 LXI H,Inb ;Furthur calls to Reader 38B6 22EB35 SHLD IFR ;the reader 38B9 C1 POP B ;VMPC 38BA E1 POP H ;VMSP 38BB C9 RET ; Routine to input from an open file 38BC E5 Inb PUSH H ;Save VMSP 38BD C5 PUSH B ;Save VMPC 38BE 2A6532 RD1 LHLD IFP 38C1 116733 LXI D,IFB+100H 38C4 7C MOV A,H 38C5 BA CMP D 38C6 C2CE38 JNZ RD2 38C9 7D MOV A,L 38CA BB CMP E 38CB CADA38 JZ RD3 38CE 7E RD2 MOV A,M 38CF 23 INX H 38D0 226532 SHLD IFP 38D3 C1 POP B ;VMPC 38D4 2A3232 LHLD TMStack ;Here's where 38D7 77 MOV M,A ;we put it 38D8 E1 POP H ;VMSP 38D9 C9 RET 38DA 2A6332 RD3 LHLD IFS 38DD 7C MOV A,H 38DE B7 ORA A 38DF C2EC38 JNZ RD4 38E2 B5 ORA L 38E3 C2EC38 JNZ RD4 L/1 Interpreter Source list August 10, 1980 Copywrite 1980 by Ralph E. Kenyon Jr. page 15 ; We've reached the end of the input file ; so, we ask for another one 38E6 213038 LXI H,Ifprn 38E9 C30438 JMP IFR1 38EC 2B RD4 DCX H ;Got to get another 38ED 226332 SHLD IFS ;sector from disk 38F0 216732 LXI H,IFB 38F3 226532 SHLD IFP 38F6 D5 PUSH D 38F7 EB XCHG 38F8 2A6132 LHLD IFA ;Get disk address 38FB 23 INX H ;update for next time 38FC 226132 SHLD IFA ;and save 38FF 2B DCX H ;back to the one we want 3900 C5 PUSH B ;going to preserve B 3901 0601 MVI B,1 ;Read 3903 3A6032 LDA IFD ;Drive for input file 3906 4F MOV C,A ;into C 3907 3E01 MVI A,1 ;1 sector 3909 CD0604 CALL Dio ;Get it 390C C1 POP B ;restore 390D D1 POP D ;this too 390E D2BE38 JNC RD1 ;Now we can get another byte 3911 C30F04 JMP Err 3914 57686174 Ofpr DB 'What''s the output file name? ',0 3918 27732074 391C 6865206F 3920 75747075 3924 74206669 3928 6C65206E 392C 616D653F 3930 2000 3932 FE03 CK1 CPI 3 ;Now lets check 3934 C20F04 JNZ Err ;for the 0503 error 3937 82 ADD D 3938 FE08 CPI 8 ;adds up to 8 393A C20F04 JNZ Err ;No good! 393D 214639 LXI H,Coutb 3940 22ED35 SHLD OFR 3943 C1 POP B ;VMPC 3944 E1 POP H ;VMSP 3945 C9 RET ; Ouputs jump to here 3946 E5 Coutb PUSH H ;We're outputting to the consol 3947 2A3232 LHLD TMStack 394A 7E MOV A,M 394B CD240C CALL WH1 L/1 Interpreter Source list August 10, 1980 Copywrite 1980 by Ralph E. Kenyon Jr. page 16 394E E1 POP H 394F C9 RET 3950 E5 OUTB PUSH H ;Save VMSP 3951 C5 PUSH B ;Save VMPC 3952 211439 LXI H,Ofpr ;get one from him. 3955 113432 LXI D,FDB ;File descriptor buffer 3958 014941 LXI B,'AI' ;('AI' is default ext) 395B CDDB34 CALL Gf 395E D2CF34 JNC Out2 3961 AF XRA A ;Checks for error 3962 83 ADD E ;code 0300H or 0503H 3963 C23239 JNZ CK1 ;Does not return 3966 82 ADD D ;unless one was 3967 FE03 CPI 3 ;found. Sets CARRY 3969 C20F04 JNZ Err ;Need to have ;a 0300 error 396C 213432 LXI H,FDB ;We need to save this ;for close 396F 7E MOV A,M 3970 E607 ANI 7 ;trim down to drive no. 3972 326733 STA OFD ;Drive number 3975 23 INX H 3976 7E MOV A,M ;FDE flag byte 3977 E61F ANI 1FH ;trim to file size 3979 C603 ADI 3 ;point past extension 397B 5F MOV E,A ;Put into DE 397C 1600 MVI D,0 397E 19 DAD D ;Add to Address in HL 397F EB XCHG ;FDA pointer now in DE 3980 216833 LXI H,OFA ;Where the addresses go 3983 0E04 MVI C,4 ;4 bytes to copy 3985 1A COFD LDAX D ;Get the data 3986 77 MOV M,A ;from the FDB 3987 23 INX H ;and copy into the 3988 13 INX D ;areas for our Dio 3989 0D DCR C ;routines 398A C28539 JNZ COFD ;More to copy 398D 216E33 LXI H,OFB ;Reset the 3990 226C33 SHLD OFP ;buffer pointer too 3993 219C39 LXI H,Outb ;characters thru 3996 22ED35 SHLD OFR 3999 C1 POP B ;VMPC 399A E1 POP H ;VMSP 399B C9 RET ; Routine to output to an open file ; thru calls to Outb 399C F5 Outb PUSH PSW ;For writing 399D C5 PUSH B 399E D5 PUSH D 399F E5 PUSH H 39A0 216400 LXI H,Ioret L/1 Interpreter Source list August 10, 1980 Copywrite 1980 by Ralph E. Kenyon Jr. page 17 39A3 E5 PUSH H 39A4 2A3232 LHLD TMStack ;Get the char 39A7 7E MOV A,M ;The rest of this is called as a subroutine for ;filling up the last sector with zeros also. 39A8 2A6C33 Store LHLD OFP 39AB 77 MOV M,A ;put char in buffer 39AC 116E34 LXI D,Flag 39AF 1A LDAX D 39B0 B7 ORA A 39B1 C2B639 JNZ Store1 39B4 3D DCR A ;We've been had! 39B5 12 STAX D 39B6 23 Store1 INX H ;bump pointer 39B7 226C33 SHLD OFP 39BA 116E33 LXI D,OFB 39BD 25 DCR H 39BE 7C MOV A,H 39BF BA CMP D 39C0 C0 RNZ 39C1 7D MOV A,L 39C2 BB CMP E 39C3 C0 RNZ ;pointer now points at OFB so do DIO. 39C4 226C33 SHLD OFP ;DE points at OFB 39C7 2A6A33 LHLD OFS ;Number of sectors 39CA 23 INX H ;One more 39CB 226A33 SHLD OFS 39CE 2A6833 LHLD OFA ;Disk address 39D1 23 INX H ;Up date for next time 39D2 226833 SHLD OFA 39D5 2B DCX H ;Here's where we write 39D6 3A6733 LDA OFD ;Drive 39D9 4F MOV C,A ;Drive no. 39DA 0600 MVI B,0 ;Write 39DC 3E01 MVI A,1 ;one sector 39DE CD0604 CALL Dio 39E1 DA0F04 JC Err 39E4 C9 RET ; Routines for closing the file 39E5 E5 TURNOFF PUSH H ;Save VMSP 39E6 C5 PUSH B ;Save VMPC 39E7 3A6E34 LDA Flag ;See if we're ;still Virgin. 39EA B7 ORA A ;(Also for closing 39EB CA213A JZ TO1 ;a read file.) 39EE 3A6C33 Fill LDA OFP ;Not virgin, L/1 Interpreter Source list August 10, 1980 Copywrite 1980 by Ralph E. Kenyon Jr. page 18 39F1 FE6E CPI OFB AND 0FFH 39F3 3E00 MVI A,0 39F5 CAFE39 JZ Close1 39F8 CDA839 CALL Store ;fill up last sector 39FB C3EE39 JMP Fill ;with zeros 39FE 213532 Close1 LXI H,FDB+1 3A01 7E MOV A,M 3A02 E61F ANI 1FH ;strip down to length 3A04 C605 ADI 5 ;Point past ext and FDA 3A06 5F MOV E,A 3A07 1600 MVI D,0 3A09 19 DAD D 3A0A EB XCHG ;adr of DNS now in DE 3A0B 2A6A33 LHLD OFS 3A0E EB XCHG 3A0F 73 MOV M,E 3A10 23 INX H 3A11 72 MOV M,D ;length now updated 3A12 213432 LXI H,FDB 3A15 7E MOV A,M 3A16 E67F ANI 7FH 3A18 77 MOV M,A 3A19 3E01 MVI A,1 ;enter new output ;file in directory 3A1B CDDD34 CALL Gf1 3A1E DA0F04 JC Err 3A21 AF TO1 XRA A ;Virgin exit. 3A22 326E34 STA Flag 3A25 215039 Out1 LXI H,OUTB ;Restore calling address 3A28 22ED35 SHLD OFR ;to open a file 3A2B C1 POP B ;VMPC 3A2C E1 POP H ;VMSP 3A2D C9 RET Origin hlt ;L0 MACRO instruction 3A2E 80 Origin DB 80H 3A2F Pgmaddr EQU $ ; We load the executable file on top ;of the Start code !! 3A2F 2A802D Start LHLD MEMTOP 3A32 223232 SHLD TMStack 3A35 210032 LXI H,USER 3A38 36C9 MVI M,RET ;Don't START again 3A3A 2AC72D LHLD CMPTR ;Cmd pointer 3A3D 7E MOV A,M 3A3E FE0D CPI CR 3A40 CAD434 JZ Out3 3A43 113432 LXI D,FDB ;File descriptor block ;built by Gfid 3A46 01304C LXI B,4C30H ;L/0 extension for ;default is L0 L/1 Interpreter Source list August 10, 1980 Copywrite 1980 by Ralph E. Kenyon Jr. page 19 3A49 3E60 MVI A,60H 3A4B CDDD34 CALL Gf1 3A4E DAD834 JC Out ;Something Wrong! 3A51 213432 LXI H,FDB 3A54 7E MOV A,M 3A55 E607 ANI 7 ;Kill flags 3A57 77 MOV M,A 3A58 23 INX H ;Move up to FDE flags. 3A59 7E MOV A,M 3A5A E61F ANI 1FH ;Kill flags 3A5C C603 ADI 3 ;Point past ext 3A5E 5F MOV E,A 3A5F 1600 MVI D,0 3A61 19 DAD D ;Addr of FDA 3A62 5E MOV E,M 3A63 23 INX H 3A64 56 MOV D,M 3A65 23 INX H 3A66 3A3432 LDA FDB 3A69 4F MOV C,A ;Drive to C 3A6A 0601 MVI B,1 ;Read 3A6C 7E MOV A,M ;DNS 3A6D EB XCHG ;FDA to HL 3A6E 112F3A LXI D,Pgmaddr ;Where to put it 3A71 C3E534 JMP GETP END Error total = 0 Macros defined in this assembly: L0CODE add bnz br call div hlt inb inc lad lic mod mul neg nop not outb rav ret sete setgt setlt sto sub swap Labels defined in this assembly: AR1 322C AR2 322E AR3 3230 BASE 34C5 BASE1 34AD Base 3227 Br 35B9 CIFD 38A5 CK1 3932 CMPTR 2DC7 COFD 3985 CONV 348C CR 000D Call 353C Cinb 3826 Close1 39FE Coutb 3946 DBZ 3206 DBZ1 36EB DBZER 36E5 DIVD 3699 DIVD1 36AC DIVD2 36BF DIVD3 36CB DIVD4 36DD DIVD6 36DF DIVD7 36B9 Dio 0406 Done 3730 Err 040F FDB 3234 FILE 2DCB Fetch 3471 Fill 39EE Flag 346E GETP 34E5 L/1 Interpreter Source list August 10, 1980 Copywrite 1980 by Ralph E. Kenyon Jr. page 20 GO 3511 GStL 349D GStL1 34A2 Gf 34DB Gf1 34DD Halt 360B IFA 3261 IFB 3267 IFD 3260 IFP 3265 IFR 35EB IFR1 3804 IFR2 388C IFS 3263 IFflg 346F INB 37FF Ifpr 386F Ifprn 3830 Inb 38BC Inc 37F6 Inst 3226 Ioret 0064 Jtbl 35CB Lad 352A Level 322B Lic 3581 Lic1 358F MEMTOP 2D80 MULT 364E MULT1 365F MULT2 366B MULT3 3672 MULT4 3677 MULT5 3681 MULT6 3686 MULT7 3690 MULT8 3693 MinDE 3482 Mod 36F2 Mod1 3709 Mod3 372D Msg 040C Neg 3736 Not 373F Not1 3747 Not2 3751 OFA 3368 OFB 336E OFD 3367 OFP 336C OFR 35ED OFS 336A OFflg 3470 OUTB 3950 Ofpr 3914 Origin 3A2E Out 34D8 Out0 34D6 Out1 3A25 Out2 34CF Out3 34D4 Outb 399C Ovrto 0412 Pgmaddr 3A2F Pop 347D Push 3478 RD1 38BE RD2 38CE RD3 38DA RD4 38EC Rav 37CB Ret 0528 SETE1 37A1 SUBT 36D4 SUBTR 3715 Set1 37B9 Set2 37C8 Sete 3788 Setlg 37A8 Start 3A2F Static 3229 Sto 37DF Store 39A8 Store1 39B6 Swap 3757 TEST 371D TMStack 3232 TO1 3A21 TURNOFF 39E5 USER 3200 WH0 0C20 WH1 0C24 Warm 0403 addsub 3616 branch 35A6 lic2 359B lic3 359E lic4 35A2 muldiv 362D opr 356D oprlic 3569 retn 3768